home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / tree < prev    next >
Text File  |  1993-05-25  |  1KB  |  42 lines
  1. ;;;; Implementation of COMMON LISP tree functions for Scheme
  2. ;;; from d.love@dl.ac.uk (some of this may be adapted from T sources):
  3.  
  4. (define (TREE:COPY-TREE tree)    ; from Dybvig (called tree-copy there)
  5.   (if (not (pair? tree))
  6.       tree
  7.       (cons (tree:copy-tree (car tree))
  8.         (tree:copy-tree (cdr tree)))))
  9.  
  10. (define (TREE:SUBST new old tree)
  11.     (cond ((equal? old tree) new)
  12.           ((pair? tree)
  13.            (if (equal? (car tree) old)
  14.            (cons new (tree:subst new old (cdr tree)))
  15.            (cons (tree:subst new old (car tree))
  16.              (tree:subst new old (cdr tree)))))
  17.           (else tree)))
  18.  
  19. ;; the next 2 aren't in CL (names from Dybvig)
  20. (define (TREE:SUBSTQ new old tree)
  21.     (cond ((eq? old tree) new)
  22.           ((pair? tree)
  23.            (if (eq? (car tree) old)
  24.            (cons new (tree:substq new old (cdr tree)))
  25.            (cons (tree:substq new old (car tree))
  26.              (tree:substq new old (cdr tree)))))
  27.           (else tree)))
  28.  
  29. (define (TREE:SUBSTV new old tree)
  30.     (cond ((eqv? old tree) new)
  31.           ((pair? tree)
  32.            (if (eqv? (car tree) old)
  33.            (cons new (tree:substv new old (cdr tree)))
  34.            (cons (tree:substv new old (car tree))
  35.              (tree:substv new old (cdr tree)))))
  36.           (else tree)))
  37.  
  38. (define copy-tree tree:copy-tree)
  39. (define subst tree:subst)
  40. (define substq tree:substq)
  41. (define substv tree:substv)
  42.